home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / CAD / PCONFRE2.ARJ / EDITT.LSP < prev    next >
Text File  |  1991-01-21  |  5KB  |  138 lines
  1. ; Steven Jarvis
  2. ; Master-Bilt Products
  3. ;
  4. ; AUTOCAD TEXT EDITOR
  5. ;
  6. ;      Key Definitions
  7. ;         F2 = Rotate      Ctrl ->
  8. ;         F3 = Move          Ctrl <-
  9. ;         F4 = Copy          Delete
  10. ;         F5 = New Ht.     Insert (press twice to toggle)
  11. ;         Backspace
  12. ;
  13. ;PConsulting added the error correction the rest of the credit goes to
  14. ;the above
  15.  
  16. ;------------------------- Error Function ---------------------------------
  17.  
  18. (defun PCONERR (st)
  19.  (if (/= st "Function cancelled")
  20.     (princ (strcat "\nError: "s))
  21.  )
  22.  (moder)                 ;  If prog. fails reset varibles
  23.  (setq *error* olderr)
  24.  (princ)
  25. )
  26.  
  27. ;-------- Mode Save ----- Saves variables in a list that you specify
  28.  
  29. (defun MODES (a)
  30.    (setq MLST '())
  31.    (repeat (length a)
  32.       (setq MLST (append MLST (list (list (car a) (getvar (car a))))))
  33.       (setq a (cdr a)))
  34. )
  35. ;-------- Mode Reset ----- Resets saved system variables
  36. (defun MODER ()
  37.    (repeat (length MLST)
  38.       (setvar (caar MLST) (cadar MLST))
  39.       (setq MLST (cdr MLST))
  40.    )
  41. )
  42. ;---------------------------------------------------------------------------
  43.  (setq olderr *error* *error* PCONERR)
  44.  (modes '("cmdecho"))                     ; Change these as needed
  45.   (mapcar 'setvar
  46.           '("cmdecho")                    ;make these match the above
  47.           '(0) 
  48.   )
  49. ;---------------------------------------------------------------------------
  50. (defun C:EDITT ( / Pointer Pb Ins Back Del Text Ht NewHt OldHt
  51.           Pick Epick Put Col Oldtext En Ip)
  52.  (setvar "cmdecho" 0)
  53.  (while (not En) (terpri)
  54.    (setq En (entget (car (setq Ip (entsel))))
  55.      Ip (cadr Ip)))
  56.  (cond
  57.    ((= (cdr (assoc 0 En)) "INSERT")
  58.      (command "ddatte" Ip) )
  59.    ((= (cdr (assoc 0 En)) "TEXT")
  60.        (setq Back '(setq Text (strcat (substr Text
  61.                    (if (= Col 1) 2 1)
  62.                    (if (= Col 1)(1- (strlen Text))(- Col 2) ))
  63.              (if (= Col 1) "" (substr Text Col))))
  64.          Del '(setq Text (strcat (substr Text
  65.                    (if (= Col 1) 2 1)
  66.                    (if (= Col 1)(1- (strlen Text))(1- Col) ))
  67.              (if (= Col 1) "" (substr Text (1+ Col)))))
  68.          Put '(setq Text (if (= Col 1)
  69.               (strcat (chr Pick)(substr Text (if (= Ins 1) 1 2)))
  70.               (strcat (substr Text 1 (1- Col))(chr Pick)
  71.                   (substr Text (if (= Ins 1) Col (1+ Col))))))
  72.          Ht '(progn (setq En (subst (cons 40
  73.            (if (= nil (setq NewHt (getdist (cdr (assoc 10 En))
  74.              (strcat "\nNew Height <"
  75.              (rtos (setq OldHt (cdr (assoc 40 En))) 2 2) "> : \n"))))
  76.            OldHt NewHt))(assoc 40 En) En))(entmod en))
  77.          Col 1 pick 0 Ins 0 tpick '(1)
  78.          OldText (setq Text (cdr (assoc 1 En)))
  79.          OldEn En)
  80.       (while (and (/= 13 Pick)(/= 27 Pick))
  81.     (redraw (cdr (assoc -1 En)) 3)
  82.     (princ (strcat "\n" (if (= 1 Ins) "Inssert" "Replace") " Mode\n"))
  83.     (princ Text)(terpri)
  84.     (princ
  85.       (strcat
  86.         (if (= Col 1) ""
  87.           (repeat (1- Col)
  88.         (setq Pointer (strcat (if Pointer Pointer "") " ")))) "^"))
  89.     (while (not (member (car Tpick) '(2 3 4 6)))
  90.       (setq Pick (if (= 4 (car (setq Tpick (grread)))) 300 (cadr Tpick)))
  91.       (if (or (= Pick 188)(= Pick 189)(= Pick 190))(progn
  92.         (setq Pb (getvar "pickbox"))
  93.         (command (cond ((= Pick 188) "rotate") ;determine command
  94.                ((= Pick 189) "move")
  95.                ((= Pick 190) "copy"))
  96.           (cdr (assoc -1 En)) ""               ;select objects
  97.           (cdr (assoc (if (= 0 (cdr (assoc 72 En))) 10 11) En));base pt.
  98.           pause
  99.         );command
  100.         (setvar "pickbox" 10)
  101.         (setq En (entget (ssname (ssget
  102.           (if (= Pick 188) Ip (setq Ip (getvar "lastpoint")))) 0)))
  103.         (setvar "pickbox" Pb)
  104.       ));if,progn
  105.     );while
  106.     (setq Pointer nil Tpick nil)
  107.     (setq Col
  108.       (cond
  109.         ((= Pick 243) (max 1 (1- Col)))            ; <- key
  110.         ((= Pick 8) (eval Back)(max 1 (1- Col)))        ; Backspace
  111.         ((= Pick 244) (min (1+ Col)(1+ (strlen Text)))) ; -> key
  112.         ((= Pick 211) (eval Del) Col)            ; Delete
  113.         ((= Pick 191) (eval Ht) Col)            ; New Height
  114.         ((and (< Pick 127)(> Pick 31))            ; Ascii keystroke
  115.           (eval Put)(min (1+ Col)(1+ (strlen Text))))
  116.         ((= Pick 27) (setq Text OldText En OldEn) Col)  ; Esc
  117.         ((and (= (type Pick) 'LIST)(not (null (ssget Pick)))) ; Text pick
  118.           (setq Epick (entget (ssname (ssget Pick) 0))
  119.             Text (cdr (assoc 1 Epick))
  120.             Pick 13)
  121.           Col)
  122.         ((= Pick 300) (setq Ins (abs (1- Ins))) Col) ; Insert toggle
  123.         ((= Pick 0) (setq Pick 13) Col)         ; Buttons return
  124.         (t Col)
  125.     ) );cond,setq
  126.       );while
  127.     (setq En (subst (cons 1 Text)(assoc 1 En) En))
  128.     (entmod En)
  129.     (princ)
  130.   );cond TEXT
  131.   (t (prompt "\nInvalid Entity Selection... ")(terpri))
  132. ;---------------
  133.  (moder)                                                 ;resets varibles 
  134.  (setq *error* olderr) 
  135.  (princ)
  136.  );opening cond
  137. );Edit
  138.